home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TCYBER25 / CYGAME.ZIP / GAMEDLG.PAS < prev   
Pascal/Delphi Source File  |  1994-10-20  |  23KB  |  201 lines
  1. {
  2. Turbo Vision CyberTools 2.5
  3. (C) 1994 Steve Goldsmith
  4. All Rights Reserved
  5. }
  6.  
  7. UNIT GAMEDLG ;{$I APP.INC} INTERFACE USES DOS , OBJECTS , APP , VIEWS , DIALOGS , DRIVERS , COLORSEL , VGA , COMMDLGS ,
  8. TVSTR , CGCMDS ;CONST GAMEMATLINES =7 ;GAMEINVATTR =9 ;GAMEUFOATTR =10 ;TYPE GAMEMATRIX =ARRAY [ 0 .. GAMEMATLINES ]
  9. OF LONGINT ;PBACKVIEW =^TBACKVIEW ;TBACKVIEW =OBJECT (TVIEW)PROCEDURE DRAW ;VIRTUAL;END ;PSPRITEVIEW =^TSPRITEVIEW ;
  10. TSPRITEVIEW =OBJECT (TVIEW)FRAMESIZE , FRAMEPOS , ENDPOS , PALINDEX :BYTE ;DIR :TPOINT ;SPRITESTR :PSTRING ;
  11. CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;S :PSTRING ;D :TPOINT );PROCEDURE CALCMOVE ;VIRTUAL;PROCEDURE DRAW ;VIRTUAL;END ;
  12. PUFOVIEW =^TUFOVIEW ;TUFOVIEW =OBJECT (TSPRITEVIEW)PROCEDURE CALCMOVE ;VIRTUAL;END ;PBOMBVIEW =^TBOMBVIEW ;
  13. TBOMBVIEW =OBJECT (TSPRITEVIEW)PROCEDURE CALCMOVE ;VIRTUAL;END ;PEXPVIEW =^TEXPVIEW ;
  14. TEXPVIEW =OBJECT (TSPRITEVIEW)PROCEDURE CALCMOVE ;VIRTUAL;END ;PSHIPVIEW =^TSHIPVIEW ;
  15. TSHIPVIEW =OBJECT (TSPRITEVIEW)PROCEDURE CALCMOVE ;VIRTUAL;END ;PSHOTVIEW =^TSHOTVIEW ;
  16. TSHOTVIEW =OBJECT (TSPRITEVIEW)PROCEDURE CALCMOVE ;VIRTUAL;END ;PHEADVIEW =^THEADVIEW ;
  17. THEADVIEW =OBJECT (TSPRITEVIEW)DELAY , DELAYVAL :WORD ;PROCEDURE CALCMOVE ;VIRTUAL;END ;FREQTABLEPTR =^FREQTABLE ;
  18. FREQTABLE =ARRAY [ 0 .. 8191 ]  OF WORD ;PGAMEDLG =^TGAMEDLG ;TGAMEDLG =OBJECT (TDIALOG)CURCH , LEFTCH , RIGHTCH ,
  19. SHOOTCH , STOPCH :CHAR ;CURSNDSEQ , ENDSNDSEQ , GAMESTATE , INVADERCNT , INVADERPTS , UFOBOMB :WORD ;LEVEL , SHIPCNT ,
  20. LASTTIMER , SCORE :LONGINT ;FREQDATA :FREQTABLEPTR ;UFO :PUFOVIEW ;BOMB :PBOMBVIEW ;EXP :PEXPVIEW ;SHIP :PSHIPVIEW ;
  21. SHOT :PSHOTVIEW ;HEAD :PHEADVIEW ;ANIGROUP :PGROUP ;SCORELINE , SHIPSLINE , LEVELLINE :PINPUTLINE ;CONSTRUCTOR INIT
  22. (T :STRING ;LC ,RC,SC,PC:CHAR );DESTRUCTOR DONE ;VIRTUAL;PROCEDURE SETSTATE (ASTATE :WORD ;ENABLE :BOOLEAN );VIRTUAL;
  23. FUNCTION GETPALETTE :PPALETTE ;VIRTUAL;PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );VIRTUAL;PROCEDURE SOUNDOFF ;
  24. PROCEDURE SETSOUND (SNDARR :POINTER ;E :WORD );PROCEDURE PLAYSOUND ;PROCEDURE NEXTLEVEL ;PROCEDURE DISPSCORE ;
  25. PROCEDURE DISPLEVEL ;PROCEDURE DISPSHIPS ;PROCEDURE INVADERHIT (P :PSPRITEVIEW );PROCEDURE MATRIXINVADERS
  26. (X1 ,Y1,D:INTEGER ;MAT :GAMEMATRIX );PROCEDURE DRAWINVADERS ;PROCEDURE DELETEINVADERS ;PROCEDURE INITUFO ;
  27. PROCEDURE DRAWUFO ;PROCEDURE INITSHIP ;PROCEDURE DRAWSHIP ;PROCEDURE INITSPRITES ;PROCEDURE DRAWSPRITES ;END ;
  28. GAMEOPTSDATA =RECORD LEFT , RIGHT , SHOOT , STOP :STRING [ 1 ] ;SOUNDFLAG :INTEGER END ;PGAMEOPTSDLG =^TGAMEOPTSDLG ;
  29. TGAMEOPTSDLG =OBJECT (TDIALOG)CONSTRUCTOR INIT ;END ;CONST GAMEANIMATE =$0001 ;GAMESHIPHIT =$0002 ;GAMEINVADERHIT =$0004
  30. ;GAMEPLAYSOUND =$0100 ;GAMESOUNDON =$0200 ;GAMEENDROUND =$1000 ;GAMEENDGAME =$2000 ;
  31. CANICOLOR =#$00#$00#$00#$00#$00#$00#$00;CANIPAL =#136#137#138#139#140#141#142;CGRAPHCOLOR =#$00;CGRAPHPAL =#143;
  32. GAMEINVADER :STRING [ 12 ] =#1#2#255+ #3#4#5+ #6#7#8+ #9#10#11;GAMEUFO :STRING [ 6 ] =#12#13#255+ #14#15#16;
  33. GAMEBOMB :STRING [ 4 ] =#17#18#19#20;GAMEEXP :STRING [ 18 ]
  34. =#21#21#21#21#22#22#22#22#23#23#23#23#22#22#22#22#21#21#21#21;GAMESHIP :STRING [ 12 ] =#24#25#255+ #26#27#28+ #29#30#31+
  35. #32#33#34;GAMESHOT :STRING [ 4 ] =#35#36#37#38;GAMEHEAD :STRING [ 140 ] =#255#64#65#66#67+ #68#69#70#70#72+
  36. #73#74#75#76#77+ #78#79#80#81#82+ #255#83#84#85#86+ #255#87#88#89#90+ #255#91#92#93#94+ #255#95#96#97#98+
  37. #255#99#100#101#102+ #255#103#104#105#106+ #255#107#108#109#110+ #255#111#112#113#114+ #255#115#116#117#118+
  38. #255#119#120#121#122+ #255#123#124#125#126+ #255#127#128#129#255+ #255#130#131#132#133+ #255#134#135#136#137+
  39. #255#138#139#140#141+ #255#142#143#144#255+ #255#145#146#147#148+ #255#149#150#151#152+ #255#153#154#155#156+
  40. #255#157#158#159#255+ #255#160#161#162#255+ #255#163#164#165#166+ #255#167#168#169#170+ #255#171#172#173#255;
  41. GAMEMATBLOCK1 :GAMEMATRIX =($ffff0000 , $ffff0000 , $ffff0000 , $ffff0000 , $00000000 , $00000000 , $00000000 , $00000000
  42. );GAMEMATBLOCK2 :GAMEMATRIX =($00000000 , $fff00000 , $00000000 , $fff00000 , $00000000 , $fff00000 , $00000000 ,
  43. $00000000 );GAMEMATBLOCK3 :GAMEMATRIX =($fff00000 , $00000000 , $fff00000 , $00000000 , $fff00000 , $00000000 , $00000000
  44. , $00000000 );GAMEMATBLOCK4 :GAMEMATRIX =($ffff0000 , $ffff0000 , $ffff0000 , $ffff0000 , $ffff0000 , $ffff0000 ,
  45. $ffff0000 , $ffff0000 );GAMEMATBLOCK5 :GAMEMATRIX =($00000000 , $ffff0000 , $00000000 , $ffff0000 , $00000000 , $ffff0000
  46. , $00000000 , $ffff0000 );GAMEMATBLOCK6 :GAMEMATRIX =($fffff000 , $00000000 , $fffff000 , $00000000 , $fffff000 ,
  47. $00000000 , $fffff000 , $00000000 );GAMEINVCOLOR :ARRAY [ 0 .. 6 ]  OF ARRAY [ 0 .. VGARGBMAX ]  OF BYTE =((0 , 63 , 0 ),
  48. (0 , 0 , 63 ), (63 , 0 , 0 ), (0 , 47 , 47 ), (63 , 63 , 0 ), (31 , 63 , 0 ), (15 , 63 , 15 ));SNDSHOT :ARRAY [ 0 .. 1 ]
  49.  OF WORD =($4000 , $3000 );SNDINVADER :ARRAY [ 0 .. 2 ]  OF WORD =($0800 , $1000 , $2000 );SNDUFO :ARRAY [ 0 .. 8 ]
  50.  OF WORD =($1100 , $1200 , $1100 , $1300 , $1200 , $1400 , $1300 , $1500 , $1400 );SNDSHIP :ARRAY [ 0 .. 8 ]
  51.  OF WORD =($1000 , $2000 , $3000 , $4000 , $5000 , $6000 , $7000 , $8000 , $9000 );
  52. IMPLEMENTATION PROCEDURE TBACKVIEW.DRAW ;VAR OI1OllllOl1:TDRAWBUFFER;BEGIN MOVECHAR (OI1OllllOl1 [ 0 ] , ' ', GETCOLOR
  53. (33 ), SIZE.X );WRITELINE (0 , 0 , SIZE.X , SIZE.Y , OI1OllllOl1 )END ;CONSTRUCTOR TSPRITEVIEW.INIT (VAR BOUNDS:TRECT;
  54. S:PSTRING;D:TPOINT);BEGIN INHERITED INIT(BOUNDS );SPRITESTR := S ;DIR := D ;FRAMESIZE := SIZE.X * SIZE.Y ;FRAMEPOS := 1 ;
  55. ENDPOS := LENGTH (SPRITESTR ^)- FRAMESIZE + 1 END ;PROCEDURE TSPRITEVIEW.CALCMOVE ;BEGIN IF DIR.X > 0 THEN BEGIN IF
  56. FRAMEPOS < ENDPOS THEN INC (FRAMEPOS , FRAMESIZE )ELSE BEGIN ORIGIN.X := ORIGIN.X + DIR.X ;FRAMEPOS := 1 END END ELSE IF
  57. DIR.X < 0 THEN BEGIN IF FRAMEPOS > 1 THEN DEC (FRAMEPOS , FRAMESIZE )ELSE BEGIN ORIGIN.X := ORIGIN.X + DIR.X ;FRAMEPOS :=
  58. ENDPOS END END ;IF ORIGIN.X > OWNER ^. SIZE.X THEN BEGIN FRAMEPOS := ENDPOS ;ORIGIN.X := OWNER ^. SIZE.X ;DIR.X := - 1 ;
  59. INC (ORIGIN.Y );IF ORIGIN.Y > OWNER ^. SIZE.Y THEN ORIGIN.Y := 0 END ELSE IF ORIGIN.X < - SIZE.X THEN BEGIN FRAMEPOS := 1
  60. ;ORIGIN.X := - SIZE.X ;DIR.X := 1 ;INC (ORIGIN.Y );IF ORIGIN.Y > OWNER ^. SIZE.Y THEN ORIGIN.Y := 0 END END ;
  61. PROCEDURE TSPRITEVIEW.DRAW ;VAR OI1OllllOl1:TDRAWBUFFER;OOIO,OOIl:BYTE;BEGIN FOR OOIl := 0 TO SIZE.Y - 1
  62.  DO BEGIN FOR OOIO := 0 TO SIZE.X - 1  DO MOVECHAR (OI1OllllOl1 [ OOIO ] , SPRITESTR ^[ OOIl * SIZE.X + OOIO + FRAMEPOS ]
  63. , GETCOLOR (PALINDEX ), 1 );WRITELINE (0 , OOIl , SIZE.X , 1 , OI1OllllOl1 )END END ;PROCEDURE TUFOVIEW.CALCMOVE ;
  64. BEGIN IF DIR.X > 0 THEN BEGIN IF FRAMEPOS < ENDPOS THEN INC (FRAMEPOS , FRAMESIZE )ELSE BEGIN ORIGIN.X := ORIGIN.X +
  65. DIR.X ;FRAMEPOS := 1 END END ELSE IF DIR.X < 0 THEN BEGIN IF FRAMEPOS > 1 THEN DEC (FRAMEPOS , FRAMESIZE )ELSE
  66. BEGIN ORIGIN.X := ORIGIN.X + DIR.X ;FRAMEPOS := ENDPOS END END ;IF ORIGIN.X > OWNER ^. SIZE.X THEN BEGIN FRAMEPOS :=
  67. ENDPOS ;ORIGIN.X := OWNER ^. SIZE.X ;DIR.X := - 1 ;ORIGIN.Y := RANDOM (OWNER ^. SIZE.Y - 4 )END ELSE IF ORIGIN.X < -
  68. SIZE.X THEN BEGIN FRAMEPOS := 1 ;ORIGIN.X := - SIZE.X ;DIR.X := 1 ;ORIGIN.Y := RANDOM (OWNER ^. SIZE.Y - 4 )END END ;
  69. PROCEDURE TBOMBVIEW.CALCMOVE ;BEGIN IF STATE AND SFVISIBLE =SFVISIBLE THEN BEGIN IF FRAMEPOS < ENDPOS THEN INC (FRAMEPOS
  70. , FRAMESIZE )ELSE BEGIN ORIGIN.Y := ORIGIN.Y + DIR.Y ;FRAMEPOS := 1 END END END ;PROCEDURE TEXPVIEW.CALCMOVE ;BEGIN IF
  71. STATE AND SFVISIBLE =SFVISIBLE THEN BEGIN IF FRAMEPOS < ENDPOS THEN INC (FRAMEPOS , FRAMESIZE )ELSE HIDE END END ;
  72. PROCEDURE TSHIPVIEW.CALCMOVE ;BEGIN IF STATE AND SFVISIBLE =SFVISIBLE THEN BEGIN IF (ORIGIN.X < OWNER ^. SIZE.X - 1 )AND
  73. (DIR.X > 0 )THEN BEGIN IF FRAMEPOS < ENDPOS THEN INC (FRAMEPOS , FRAMESIZE )ELSE BEGIN ORIGIN.X := ORIGIN.X + DIR.X ;
  74. FRAMEPOS := 1 END END ;IF (ORIGIN.X >= 0 )AND (DIR.X < 0 )THEN BEGIN IF FRAMEPOS > 1 THEN DEC (FRAMEPOS , FRAMESIZE )ELSE
  75. BEGIN ORIGIN.X := ORIGIN.X + DIR.X ;FRAMEPOS := ENDPOS END END END END ;PROCEDURE TSHOTVIEW.CALCMOVE ;BEGIN IF FRAMEPOS <
  76. ENDPOS THEN INC (FRAMEPOS , FRAMESIZE )ELSE BEGIN ORIGIN.Y := ORIGIN.Y + DIR.Y ;FRAMEPOS := 1 END ;IF ORIGIN.Y < 0 THEN
  77. HIDE END ;PROCEDURE THEADVIEW.CALCMOVE ;BEGIN IF STATE AND SFVISIBLE =SFVISIBLE THEN BEGIN DEC (DELAY );IF DELAY =0 THEN
  78. BEGIN IF FRAMEPOS < ENDPOS THEN INC (FRAMEPOS , FRAMESIZE )ELSE HIDE ;DELAY := DELAYVAL END END END ;
  79. CONSTRUCTOR TGAMEDLG.INIT (T:STRING ;LC,RC,SC,PC:CHAR);VAR OO1I:TRECT;O10lI1l00O:PBACKVIEW;BEGIN OO1I.ASSIGN (0 , 0 , 75
  80. , 20 );INHERITED INIT(OO1I , T );OPTIONS := OPTIONS OR OFCENTERED ;PALETTE := DPBLUEDIALOG ;GAMESTATE := GAMESTATE OR
  81. GAMEANIMATE ;SHIPCNT := 5 ;INVADERCNT := 0 ;CURSNDSEQ := 0 ;ENDSNDSEQ := 0 ;FREQDATA := NIL ;LASTTIMER := LONGINT (PTR
  82. (SEG0040 , $6c )^);LEFTCH := UPCASE (LC );RIGHTCH := UPCASE (RC );SHOOTCH := UPCASE (SC );STOPCH := UPCASE (PC );
  83. OO1I.ASSIGN (63 , 3 , 73 , 4 );SCORELINE := NEW (PINPUTLINE , INIT (OO1I , 8 ));SCORELINE ^. OPTIONS := SCORELINE ^.
  84. OPTIONS AND NOT OFSELECTABLE ;INSERT (SCORELINE );DISPSCORE ;OO1I.ASSIGN (62 , 2 , 68 , 3 );INSERT (NEW (PLABEL , INIT
  85. (OO1I , 'Score', NIL )));OO1I.ASSIGN (63 , 5 , 73 , 6 );LEVELLINE := NEW (PINPUTLINE , INIT (OO1I , 8 ));LEVELLINE ^.
  86. OPTIONS := SCORELINE ^. OPTIONS AND NOT OFSELECTABLE ;INSERT (LEVELLINE );DISPLEVEL ;OO1I.ASSIGN (62 , 4 , 68 , 5 );
  87. INSERT (NEW (PLABEL , INIT (OO1I , 'Level', NIL )));OO1I.ASSIGN (63 , 7 , 73 , 8 );SHIPSLINE := NEW (PINPUTLINE , INIT
  88. (OO1I , 8 ));SHIPSLINE ^. OPTIONS := SCORELINE ^. OPTIONS AND NOT OFSELECTABLE ;INSERT (SHIPSLINE );DISPSHIPS ;
  89. OO1I.ASSIGN (62 , 6 , 68 , 7 );INSERT (NEW (PLABEL , INIT (OO1I , 'Ships', NIL )));OO1I.ASSIGN (62 , 15 , 73 , 17 );
  90. INSERT (NEW (PBUTTON , INIT (OO1I , '~P~lay', CMANION , BFNORMAL )));OO1I.ASSIGN (62 , 17 , 73 , 19 );INSERT (NEW
  91. (PBUTTON , INIT (OO1I , '~S~top', CMANIOFF , BFNORMAL )));OO1I.ASSIGN (2 , 1 , 62 , 19 );ANIGROUP := NEW (PGROUP , INIT
  92. (OO1I ));ANIGROUP ^. GETEXTENT (OO1I );O10lI1l00O := NEW (PBACKVIEW , INIT (OO1I ));ANIGROUP ^. INSERT (O10lI1l00O );
  93. INITSPRITES ;INSERT (ANIGROUP )END ;DESTRUCTOR TGAMEDLG.DONE ;BEGIN SOUNDOFF ;INHERITED DONE END ;
  94. PROCEDURE TGAMEDLG.SETSTATE (ASTATE:WORD;ENABLE:BOOLEAN);BEGIN INHERITED SETSTATE(ASTATE , ENABLE );IF ASTATE =SFFOCUSED
  95. THEN BEGIN IF LEVEL < 8 THEN BEGIN SOUNDOFF ;SETDAC (GETATTRCONT (GAMEINVATTR ), GAMEINVCOLOR [ LEVEL - 1 , 0 ] ,
  96. GAMEINVCOLOR [ LEVEL - 1 , 1 ] , GAMEINVCOLOR [ LEVEL - 1 , 2 ] );SETDAC (GETATTRCONT (GAMEUFOATTR ), GAMEINVCOLOR [
  97. LEVEL - 1 , 0 ] , GAMEINVCOLOR [ LEVEL - 1 , 1 ] , GAMEINVCOLOR [ LEVEL - 1 , 2 ] );FONTMAPSELECT (VGACHRTABLEMAP1 [ 0 ]
  98. , VGACHRTABLEMAP2 [ LEVEL ] )END ELSE BEGIN SOUNDOFF ;FONTMAPSELECT (VGACHRTABLEMAP1 [ 0 ] , VGACHRTABLEMAP2 [ RANDOM (7
  99. )+ 1 ] )END END END ;FUNCTION TGAMEDLG.GETPALETTE :PPALETTE ;CONST OOlOIOI1Oll1=CBLUEDIALOG+ CANIPAL;
  100. O10O1I10lIIO0=CCYANDIALOG+ CANIPAL;OIO1IO1ll10=CGRAYDIALOG+ CANIPAL;OO10:ARRAY [ DPBLUEDIALOG.. DPGRAYDIALOG]  OF STRING
  101. [ LENGTH(OOlOIOI1Oll1)] =(OOlOIOI1Oll1, O10O1I10lIIO0, OIO1IO1ll10);BEGIN GETPALETTE := @ OO10 [ PALETTE ] ;END ;
  102. PROCEDURE TGAMEDLG.HANDLEEVENT (VAR EVENT:TEVENT);PROCEDURE O100Ol011O ;BEGIN IF SHOT ^. STATE AND SFVISIBLE =0 THEN
  103. BEGIN SETSOUND (@ SNDSHOT , 1 );SHOT ^. ORIGIN.X := SHIP ^. ORIGIN.X ;IF SHIP ^. FRAMEPOS > 6 THEN INC (SHOT ^. ORIGIN.X
  104. );SHOT ^. ORIGIN.Y := SHIP ^. ORIGIN.Y - 1 ;SHOT ^. FRAMEPOS := 1 ;SHOT ^. SHOW END END ;PROCEDURE OIIIO01I0 ;
  105. VAR OOO0IlO0OI1O:STRING [ 8 ] ;BEGIN SETSOUND (@ SNDSHIP , 8 );GAMESTATE := GAMESTATE AND NOT GAMESHIPHIT ;SHIP ^. HIDE ;
  106. DEC (SHIPCNT );DISPSHIPS ;WITH HEAD^ DO BEGIN FRAMEPOS := 1 ;ORIGIN.X := SHIP ^. ORIGIN.X - 2 ;ORIGIN.Y := SHIP ^.
  107. ORIGIN.Y - 3 ;SHOW END ;DEC (LEVEL );NEXTLEVEL ;IF SHIPCNT =0 THEN BEGIN GAMESTATE := (GAMESTATE AND NOT GAMEANIMATE )OR
  108. GAMEENDGAME ;OOO0IlO0OI1O := 'GAME END';SHIPSLINE ^. SETDATA (OOO0IlO0OI1O );SOUNDOFF END END ;
  109. BEGIN INHERITED HANDLEEVENT(EVENT );CASE EVENT.WHAT  OF EVKEYDOWN :IF (GAMESTATE AND GAMEANIMATE <> 0 )AND (STATE AND
  110. SFFOCUSED <> 0 )AND (SHIP ^. STATE AND SFVISIBLE <> 0 )THEN BEGIN CURCH := UPCASE (EVENT.CHARCODE );IF CURCH =LEFTCH THEN
  111. SHIP ^. DIR.X := - 1 ELSE IF CURCH =RIGHTCH THEN SHIP ^. DIR.X := 1 ELSE IF CURCH =STOPCH THEN SHIP ^. DIR.X := 0 ELSE IF
  112. CURCH =SHOOTCH THEN O100Ol011O ELSE EXIT ;CLEAREVENT (EVENT )END ;EVCOMMAND :BEGIN CASE EVENT.COMMAND  OF CMANIOFF
  113. :BEGIN GAMESTATE := GAMESTATE AND NOT GAMEANIMATE ;SOUNDOFF END ;CMANION :GAMESTATE := GAMESTATE OR GAMEANIMATE ELSE EXIT
  114. END ;CLEAREVENT (EVENT )END ;EVBROADCAST :IF (GAMESTATE AND GAMEANIMATE <> 0 )AND (GAMESTATE AND GAMEENDGAME =0 )AND
  115. (STATE AND SFFOCUSED <> 0 )THEN BEGIN CASE EVENT.COMMAND  OF CMANIMATE :BEGIN PLAYSOUND ;DRAWSPRITES ;IF GAMESTATE AND
  116. GAMEINVADERHIT <> 0 THEN BEGIN GAMESTATE := GAMESTATE AND NOT GAMEINVADERHIT ;DISPSCORE END ;IF GAMESTATE AND GAMESHIPHIT
  117. <> 0 THEN OIIIO01I0 ;IF GAMESTATE AND GAMEENDROUND <> 0 THEN NEXTLEVEL END END END END END ;PROCEDURE TGAMEDLG.SOUNDOFF ;
  118. BEGIN IF GAMESTATE AND GAMESOUNDON <> 0 THEN ASM {} IN AL , 61h {} AND AL , 11111100B{} OUT 61h , AL {} END END ;
  119. PROCEDURE TGAMEDLG.SETSOUND (SNDARR:POINTER;E:WORD);BEGIN IF (GAMESTATE AND GAMESOUNDON <> 0 )AND (GAMESTATE AND
  120. GAMEPLAYSOUND =0 )THEN BEGIN CURSNDSEQ := 0 ;ENDSNDSEQ := E ;FREQDATA := SNDARR ;GAMESTATE := GAMESTATE OR GAMEPLAYSOUND
  121. END END ;PROCEDURE TGAMEDLG.PLAYSOUND ;VAR OI1II1O1OO0l:WORD;BEGIN IF (GAMESTATE AND GAMESOUNDON <> 0 )AND (GAMESTATE AND
  122. GAMEPLAYSOUND <> 0 )AND (LONGINT (PTR (SEG0040 , $6c )^)<> LASTTIMER )THEN BEGIN IF CURSNDSEQ <= ENDSNDSEQ THEN
  123. BEGIN LASTTIMER := LONGINT (PTR (SEG0040 , $6c )^);OI1II1O1OO0l := FREQDATA ^[ CURSNDSEQ ] ;ASM {} MOV AL , 10110110B{}
  124. OUT 43h , AL {} MOV AX , OI1II1O1OO0l{} OUT 42h , AL {} MOV AL , AH {} OUT 42h , AL {} IN AL , 61h {}
  125. OR AL , 00000011B{} OUT 61h , AL {} END;INC (CURSNDSEQ )END ELSE BEGIN SOUNDOFF ;GAMESTATE := GAMESTATE AND NOT
  126. GAMEPLAYSOUND END END END ;PROCEDURE TGAMEDLG.NEXTLEVEL ;BEGIN GAMESTATE := GAMESTATE AND NOT GAMEENDROUND ;INC (LEVEL );
  127. DISPLEVEL ;DELETEINVADERS ;IF LEVEL < 8 THEN BEGIN SETDAC (GETATTRCONT (GAMEINVATTR ), GAMEINVCOLOR [ LEVEL - 1 , 0 ] ,
  128. GAMEINVCOLOR [ LEVEL - 1 , 1 ] , GAMEINVCOLOR [ LEVEL - 1 , 2 ] );SETDAC (GETATTRCONT (GAMEUFOATTR ), GAMEINVCOLOR [
  129. LEVEL - 1 , 0 ] , GAMEINVCOLOR [ LEVEL - 1 , 1 ] , GAMEINVCOLOR [ LEVEL - 1 , 2 ] );FONTMAPSELECT (VGACHRTABLEMAP1 [ 0 ]
  130. , VGACHRTABLEMAP2 [ LEVEL ] )END ;CASE LEVEL  OF 1 :BEGIN MATRIXINVADERS (10 , 1 , 1 , GAMEMATBLOCK1 );INVADERPTS := 100
  131. ;UFOBOMB := 20 END ;2 :BEGIN MATRIXINVADERS (10 , 3 , 1 , GAMEMATBLOCK1 );INVADERPTS := 100 ;UFOBOMB := 15 END ;3
  132. :BEGIN MATRIXINVADERS (10 , 1 , 1 , GAMEMATBLOCK2 );MATRIXINVADERS (10 , 1 , - 1 , GAMEMATBLOCK3 );INVADERPTS := 200 ;
  133. UFOBOMB := 10 END ;4 :BEGIN MATRIXINVADERS (10 , 2 , 1 , GAMEMATBLOCK2 );MATRIXINVADERS (10 , 2 , - 1 , GAMEMATBLOCK3 );
  134. INVADERPTS := 200 ;UFOBOMB := 8 END ;5 :BEGIN MATRIXINVADERS (8 , - 2 , 1 , GAMEMATBLOCK4 );INVADERPTS := 300 ;UFOBOMB :=
  135. 7 END ;6 :BEGIN MATRIXINVADERS (8 , 0 , 1 , GAMEMATBLOCK4 );INVADERPTS := 300 ;UFOBOMB := 5 END ;7 :BEGIN MATRIXINVADERS
  136. (0 , 0 , 1 , GAMEMATBLOCK5 );MATRIXINVADERS (0 , 0 , - 1 , GAMEMATBLOCK6 );INVADERPTS := 400 ;UFOBOMB := 2 END ELSE
  137. BEGIN FONTMAPSELECT (VGACHRTABLEMAP1 [ 0 ] , VGACHRTABLEMAP2 [ RANDOM (7 )+ 1 ] );MATRIXINVADERS (0 , 0 , 1 ,
  138. GAMEMATBLOCK5 );MATRIXINVADERS (0 , 0 , - 1 , GAMEMATBLOCK6 );INVADERPTS := 500 ;UFOBOMB := 0 END END END ;
  139. PROCEDURE TGAMEDLG.DISPSCORE ;VAR OOO0IlO0OI1O:STRING [ 8 ] ;BEGIN FORMATSTR (OOO0IlO0OI1O , '%0#%08d', SCORE );
  140. SCORELINE ^. SETDATA (OOO0IlO0OI1O )END ;PROCEDURE TGAMEDLG.DISPLEVEL ;VAR OOO0IlO0OI1O:STRING [ 8 ] ;BEGIN FORMATSTR
  141. (OOO0IlO0OI1O , '%0#%8d', LEVEL );LEVELLINE ^. SETDATA (OOO0IlO0OI1O )END ;PROCEDURE TGAMEDLG.DISPSHIPS ;
  142. VAR OOO0IlO0OI1O:STRING [ 8 ] ;BEGIN FORMATSTR (OOO0IlO0OI1O , '%0#%8d', SHIPCNT );SHIPSLINE ^. SETDATA (OOO0IlO0OI1O
  143. )END ;PROCEDURE TGAMEDLG.INVADERHIT (P:PSPRITEVIEW);BEGIN SETSOUND (@ SNDINVADER , 2 );P ^. HIDE ;DEC (INVADERCNT );IF
  144. INVADERCNT =0 THEN GAMESTATE := GAMESTATE OR GAMEENDROUND ;GAMESTATE := GAMESTATE OR GAMEINVADERHIT END ;
  145. PROCEDURE TGAMEDLG.MATRIXINVADERS (X1,Y1,D:INTEGER;MAT:GAMEMATRIX);VAR OOIO,OOIl:INTEGER;O10OIIllIl00l:LONGINT;
  146. OIO1,OO1I:TRECT;OO10:TPOINT;O1I01Oll:PSPRITEVIEW;BEGIN ANIGROUP ^. GETBOUNDS (OIO1 );OO10.X := D ;OO10.Y := 0 ;FOR OOIl
  147. := 0 TO GAMEMATLINES  DO BEGIN O10OIIllIl00l := $8000000 ;FOR OOIO := 0 TO 31  DO BEGIN IF MAT [ OOIl ] AND O10OIIllIl00l
  148. <> 0 THEN BEGIN OO1I.ASSIGN (OOIO * 3 + X1 + OIO1.A.X , OOIl * 2 + Y1 + OIO1.A.Y , OOIO * 3 + X1 + OIO1.A.X + 3 , OOIl *
  149. 2 + Y1 + OIO1.A.Y + 1 );O1I01Oll := NEW (PSPRITEVIEW , INIT (OO1I , @ GAMEINVADER , OO10 ));O1I01Oll ^. PALINDEX := 34 ;
  150. ANIGROUP ^. INSERT (O1I01Oll );INC (INVADERCNT )END ;IF OOIO <> 31 THEN O10OIIllIl00l := O10OIIllIl00l SHR 1 END END END
  151. ;PROCEDURE TGAMEDLG.DRAWINVADERS ;PROCEDURE OOIl10OO111l (OO10:PSPRITEVIEW);FAR ;BEGIN IF TYPEOF (OO10 ^)=TYPEOF
  152. (TSPRITEVIEW )THEN BEGIN OO10 ^. CALCMOVE ;OO10 ^. DRAWVIEW ;IF (OO10 ^. STATE AND SFVISIBLE <> 0 )THEN BEGIN IF (SHIP ^.
  153. STATE AND SFVISIBLE <> 0 )AND (OO10 ^. ORIGIN.Y =SHIP ^. ORIGIN.Y )AND (OO10 ^. ORIGIN.X =SHIP ^. ORIGIN.X )THEN
  154. BEGIN INVADERHIT (OO10 );GAMESTATE := GAMESTATE OR GAMESHIPHIT END ;IF (SHOT ^. STATE AND SFVISIBLE <> 0 )AND (OO10 ^.
  155. ORIGIN.Y =SHOT ^. ORIGIN.Y )AND (((SHOT ^. ORIGIN.X =OO10 ^. ORIGIN.X )OR (SHOT ^. ORIGIN.X =OO10 ^. ORIGIN.X + 1 )OR
  156. (SHOT ^. ORIGIN.X =OO10 ^. ORIGIN.X + 2 )))THEN BEGIN SHOT ^. HIDE ;SCORE := SCORE + INVADERPTS ;INVADERHIT (OO10 )END
  157. END END END ;BEGIN ANIGROUP ^. FOREACH (@ OOIl10OO111l )END ;PROCEDURE TGAMEDLG.DELETEINVADERS ;PROCEDURE OOIlI1O1l01l
  158. (OO10:PSPRITEVIEW);FAR ;BEGIN IF TYPEOF (OO10 ^)=TYPEOF (TSPRITEVIEW )THEN DISPOSE (OO10 , DONE );INVADERCNT := 0 END ;
  159. BEGIN ANIGROUP ^. FOREACH (@ OOIlI1O1l01l )END ;PROCEDURE TGAMEDLG.INITUFO ;VAR OO1I:TRECT;OO10:TPOINT;BEGIN OO10.X := 0
  160. ;OO10.Y := 1 ;OO1I.ASSIGN (0 , 0 , 1 , 1 );BOMB := NEW (PBOMBVIEW , INIT (OO1I , @ GAMEBOMB , OO10 ));BOMB ^. PALINDEX :=
  161. 36 ;BOMB ^. HIDE ;ANIGROUP ^. INSERT (BOMB );OO10.X := 0 ;OO10.Y := 0 ;EXP := NEW (PEXPVIEW , INIT (OO1I , @ GAMEEXP ,
  162. OO10 ));EXP ^. PALINDEX := 37 ;EXP ^. HIDE ;ANIGROUP ^. INSERT (EXP );OO10.X := 1 ;OO10.Y := 0 ;OO1I.ASSIGN (0 , 0 , 3 ,
  163. 1 );UFO := NEW (PUFOVIEW , INIT (OO1I , @ GAMEUFO , OO10 ));UFO ^. PALINDEX := 35 ;ANIGROUP ^. INSERT (UFO )END ;
  164. PROCEDURE TGAMEDLG.DRAWUFO ;BEGIN IF (BOMB ^. STATE AND SFVISIBLE =0 )AND (UFO ^. ORIGIN.X =SHIP ^. ORIGIN.X )AND (RANDOM
  165. (UFOBOMB )=0 )THEN BEGIN BOMB ^. ORIGIN.X := UFO ^. ORIGIN.X ;BOMB ^. ORIGIN.Y := UFO ^. ORIGIN.Y ;BOMB ^. SHOW END ;IF
  166. (BOMB ^. STATE AND SFVISIBLE =SFVISIBLE )AND (BOMB ^. ORIGIN.Y =ANIGROUP ^. SIZE.Y )THEN BEGIN EXP ^. ORIGIN.X := BOMB ^.
  167. ORIGIN.X ;EXP ^. ORIGIN.Y := BOMB ^. ORIGIN.Y - 1 ;EXP ^. FRAMEPOS := 1 ;BOMB ^. HIDE ;EXP ^. SHOW END ;UFO ^. CALCMOVE ;
  168. BOMB ^. CALCMOVE ;EXP ^. CALCMOVE ;UFO ^. DRAWVIEW ;BOMB ^. DRAWVIEW ;EXP ^. DRAWVIEW ;IF (SHOT ^. STATE AND SFVISIBLE <>
  169. 0 )AND (SHOT ^. ORIGIN.Y =UFO ^. ORIGIN.Y )AND (((SHOT ^. ORIGIN.X =UFO ^. ORIGIN.X )OR (SHOT ^. ORIGIN.X =UFO ^.
  170. ORIGIN.X + 1 )OR (SHOT ^. ORIGIN.X =UFO ^. ORIGIN.X + 2 )))THEN BEGIN SETSOUND (@ SNDUFO , 8 );SHOT ^. HIDE ;SCORE :=
  171. SCORE + 500 ;DISPSCORE ;WITH UFO^ DO BEGIN FRAMEPOS := 1 ;ORIGIN.X := - SIZE.X ;DIR.X := 1 ;ORIGIN.Y := RANDOM (OWNER ^.
  172. SIZE.Y - 4 )END END ;IF (BOMB ^. STATE AND SFVISIBLE <> 0 )AND (SHIP ^. STATE AND SFVISIBLE <> 0 )AND (BOMB ^. ORIGIN.Y
  173. =SHIP ^. ORIGIN.Y )AND (((BOMB ^. ORIGIN.X =SHIP ^. ORIGIN.X )OR (BOMB ^. ORIGIN.X =SHIP ^. ORIGIN.X + 1 )OR (BOMB ^.
  174. ORIGIN.X =SHIP ^. ORIGIN.X + 2 )))THEN BEGIN BOMB ^. HIDE ;GAMESTATE := GAMESTATE OR GAMESHIPHIT END ;IF (EXP ^. STATE
  175. AND SFVISIBLE <> 0 )AND (SHIP ^. STATE AND SFVISIBLE <> 0 )AND (EXP ^. ORIGIN.Y =SHIP ^. ORIGIN.Y )AND (((EXP ^. ORIGIN.X
  176. =SHIP ^. ORIGIN.X )OR (EXP ^. ORIGIN.X =SHIP ^. ORIGIN.X + 1 )OR (EXP ^. ORIGIN.X =SHIP ^. ORIGIN.X + 2 )))THEN BEGIN EXP
  177. ^. HIDE ;GAMESTATE := GAMESTATE OR GAMESHIPHIT END END ;PROCEDURE TGAMEDLG.INITSHIP ;VAR OIO1,OO1I:TRECT;OO10:TPOINT;
  178. BEGIN ANIGROUP ^. GETBOUNDS (OIO1 );OO10.X := 0 ;OO10.Y := 0 ;OO1I.ASSIGN (OIO1.B.X DIV 2 - 1 , OIO1.B.Y - 2 , OIO1.B.X
  179. DIV 2 + 2 , OIO1.B.Y - 1 );SHIP := NEW (PSHIPVIEW , INIT (OO1I , @ GAMESHIP , OO10 ));SHIP ^. PALINDEX := 38 ;ANIGROUP ^.
  180. INSERT (SHIP );OO10.X := 0 ;OO10.Y := - 1 ;OO1I.ASSIGN (OIO1.A.X + 1 , OIO1.A.Y , OIO1.A.X + 2 , OIO1.A.Y + 1 );SHOT :=
  181. NEW (PSHOTVIEW , INIT (OO1I , @ GAMESHOT , OO10 ));SHOT ^. PALINDEX := 39 ;SHOT ^. HIDE ;ANIGROUP ^. INSERT (SHOT );
  182. OO1I.ASSIGN (0 , 0 , 5 , 4 );OO10.X := 0 ;OO10.Y := 0 ;HEAD := NEW (PHEADVIEW , INIT (OO1I , @ GAMEHEAD , OO10 ));HEAD ^.
  183. PALINDEX := 38 ;HEAD ^. HIDE ;HEAD ^. DELAYVAL := 7 ;HEAD ^. DELAY := 7 ;ANIGROUP ^. INSERT (HEAD );END ;
  184. PROCEDURE TGAMEDLG.DRAWSHIP ;BEGIN SHIP ^. CALCMOVE ;SHOT ^. CALCMOVE ;HEAD ^. CALCMOVE ;SHIP ^. DRAWVIEW ;SHOT ^.
  185. DRAWVIEW ;HEAD ^. DRAWVIEW ;IF (HEAD ^. STATE AND SFVISIBLE =0 )AND (SHIP ^. STATE AND SFVISIBLE =0 )THEN BEGIN SHIP ^.
  186. ORIGIN.X := ANIGROUP ^. SIZE.X DIV 2 - 1 ;SHIP ^. DIR.X := 0 ;SHIP ^. SHOW END END ;PROCEDURE TGAMEDLG.INITSPRITES ;
  187. BEGIN INITSHIP ;INITUFO ;NEXTLEVEL END ;PROCEDURE TGAMEDLG.DRAWSPRITES ;BEGIN ANIGROUP ^. LOCK ;DRAWINVADERS ;DRAWUFO ;
  188. DRAWSHIP ;ANIGROUP ^. LAST ^. DRAWVIEW ;ANIGROUP ^. UNLOCK END ;CONSTRUCTOR TGAMEOPTSDLG.INIT ;VAR OO1I:TRECT;
  189. OIO1000lI0l:PINPUTLINE;O1010O1lIOl0O:PCHECKBOXESCF;BEGIN OO1I.ASSIGN (0 , 0 , 29 , 10 );INHERITED INIT(OO1I ,
  190. 'Controls');OO1I.ASSIGN (10 , 2 , 13 , 3 );OIO1000lI0l := NEW (PINPUTLINE , INIT (OO1I , 1 ));INSERT (OIO1000lI0l );
  191. OO1I.ASSIGN (1 , 2 , 7 , 3 );INSERT (NEW (PLABEL , INIT (OO1I , '~L~eft', OIO1000lI0l )));OO1I.ASSIGN (10 , 3 , 13 , 4 );
  192. OIO1000lI0l := NEW (PINPUTLINE , INIT (OO1I , 1 ));INSERT (OIO1000lI0l );OO1I.ASSIGN (1 , 3 , 7 , 4 );INSERT (NEW (PLABEL
  193. , INIT (OO1I , '~R~ight', OIO1000lI0l )));OO1I.ASSIGN (10 , 4 , 13 , 5 );OIO1000lI0l := NEW (PINPUTLINE , INIT (OO1I , 1
  194. ));INSERT (OIO1000lI0l );OO1I.ASSIGN (1 , 4 , 7 , 5 );INSERT (NEW (PLABEL , INIT (OO1I , '~S~hoot', OIO1000lI0l )));
  195. OO1I.ASSIGN (10 , 5 , 13 , 6 );OIO1000lI0l := NEW (PINPUTLINE , INIT (OO1I , 1 ));INSERT (OIO1000lI0l );OO1I.ASSIGN (1 ,
  196. 5 , 7 , 6 );INSERT (NEW (PLABEL , INIT (OO1I , 'S~t~op', OIO1000lI0l )));OO1I.ASSIGN (15 , 3 , 27 , 4 );O1010O1lIOl0O :=
  197. NEW (PCHECKBOXESCF , INIT (OO1I , NEWSITEM ('On/Off', NIL )));INSERT (O1010O1lIOl0O );OO1I.ASSIGN (14 , 2 , 20 , 3 );
  198. INSERT (NEW (PLABEL , INIT (OO1I , 'Soun~d~', O1010O1lIOl0O )));OO1I.ASSIGN (2 , 7 , 12 , 9 );INSERT (NEW (PBUTTON , INIT
  199. (OO1I , 'O~K~', CMOK , BFDEFAULT )));OO1I.ASSIGN (16 , 7 , 26 , 9 );INSERT (NEW (PBUTTON , INIT (OO1I , 'Cancel',
  200. CMCANCEL , BFNORMAL )))END ;END .
  201.